SPACE 1/SPACE - Library 1 - Volume 1.iso/utilitys/57/disk_cat.pas

Pascal/Delphi Source File | 1986-10-19 | 21.4 KB | 793 lines

Program Directory_Catalog(Input,Output);

{**********************
 *   ST DISK CATALOG  *
 *    Programmed by   *
 *   Michael Ferrara  *
 * (C)1987 ST X-Press *
 **********************}


Const {$I GEMCONST.PAS}

Type  {$I GEMTYPE.PAS}
  Menu_DescType = Array[0..7] of String[15];
  Item_DescType = Array[0..35] of String[17];
  M_TitleType = Array[0..7] of Integer;
  M_ItemType = Array[0..35] of Integer;
  fname = Packed Array[1..12] of char ;
  frec = Packed Record
           reserved : Packed Array [ 0..19 ] Of byte;
           resvd2 : byte;
           attrib : byte;
           time_stamp : integer;
           date_stamp : integer;
           size : long_integer;
           name : fname;
         End;
  catalog_rec = Packed record
                   folder_num : integer;
                   fname      : string[12];
                   Desc       : String[40];
                End;

  Path_Type = Packed Array[1..80] of char;

Var
  Menu : Menu_Ptr ;
  Menu_Desc      : Menu_DescType;
  Item_Desc      : Item_DescType;
  M_Title        : M_TitleType;
  M_Item         : M_ItemType;

  Catalog      : Packed Array[1..560] of Catalog_rec;
  path_string  : string;
  path         : path_type;
  disk_name    : str255;
  folder_array : Packed array[1..125] of str255;
  folder_count,
  folder_max,
  rec_count,
  Choice : integer;

{$I GEMSUBS}

Function IO_Result : Integer; External;
Procedure IO_Check(b : boolean); External;

Procedure About_Program;
Var Box : Dialog_Ptr;
    Item_String : Array[1..9] of Str255;
    Item : Array [1..9] of Integer;
    Button : Integer;
    X : Integer;

Begin
  Item_String[1] := '           ST DISK CATALOG';
  Item_String[2] := '    Programmed by Michael Ferrara';
  Item_String[3] := '         (C)1987 ST X-Press';
  Item_String[4] := '';
  Item_String[5] := '          "The ST Informer" ';
  Item_String[6] := '';
  Item_String[7] := '         ST X-Press Magazine';
  Item_String[8] := '  P.O. Box 2383, La Habra CA 90632';
  Item_String[9] := '      Telephone: [phone]';
  Box := New_Dialog(20,0,0,40,15);
  For x := 1 to 9 do
  Begin
    Item[X] := Add_DItem(Box,G_String,None,1,X,0,1,0,0);
    Set_DText(Box,Item[X],Item_String[x],System_Font,Te_Left);
  End;
  Button:=Add_DItem(Box,G_Button,Selectable|Exit_Btn|Default,15,12,10,1,0,0);
  Set_DText(Box, Button, 'Continue', System_Font, TE_Center ) ;
  Center_Dialog(Box);
  X :=Do_Dialog(Box,0);
  End_Dialog(Box);
  Delete_Dialog(Box);
End;

Procedure Gem_Initialize;
Var X : Integer;
Begin
  Menu_Desc[0] := ' Desk ';
  Menu_Desc[1] := ' Functions ';
  Item_Desc[1] := ' Log Disk     ';
  Item_Desc[2] := ' Load Catalog ';
  Item_Desc[3] := ' Locate...    ';
  Item_Desc[4] := ' Save...      ';
  Item_Desc[5] := ' Edit/Examine ';
  Item_Desc[6] := ' Hardcopy     ';
  Item_Desc[7] := ' Quit         ';
  If Init_Gem >= 0 Then
  Begin
     Init_Mouse;
     Menu := New_Menu(35, '  About Program   ');
     X :=  1;
     M_Title[X]:=Add_MTitle(Menu, Menu_Desc[X]);
     For X :=  1 to 7 Do M_Item[X]:=Add_MItem(Menu, M_Title[1], Item_Desc[X]);
     Draw_Menu( Menu ) ;
  End;
End;

Function upcase(c:char) : char;
begin
   if ord(c) in [$61..$7A] then upcase := chr(ord(c)-$20) else upcase := c;
end;

Procedure upcase_string(var s : str255);
var i : integer;
begin
  for i := 1 to length(s) do s[i] := upcase(s[i]);
end;


Procedure Get_Entry(prompt : str255;
                    var input  : str255;
                    size   : integer;
                    var cancel : boolean);
Var Box : Dialog_Ptr;
    X : integer;
    Item_String, Dummy_string, Default_str : Str255;
    Item : Integer;
    Button : Array [1..2] of Integer;
    Button_String : Array[1..2] of Str255;
Begin
  X := Length(prompt) + Size + 10;
  Box := New_Dialog(20,0,0,X,9);
  dummy_string := '';
  for x := 1 to size do dummy_string := concat(dummy_string,'_');
  Item_String:= Concat(prompt,dummy_string);
  Default_str := '';
  Button_String[1] := 'Ok';
  Button_String[2] := 'Cancel';
  Item := Add_DItem(Box,G_FText, None, 1,3, 78, 1, 0, $1180 );
  dummy_string := '';
  for x := 1 to size do dummy_string := concat(dummy_string,'X');
  Set_DEdit(Box,Item,Item_String,dummy_string,Default_str,System_Font,Te_Left);
  Button[1]:=Add_DItem(Box,G_Button,Selectable|Exit_Btn|Default,3,6,10,1,0,0);
  Set_DText(Box, Button[1], Button_String[1], System_Font, TE_Center ) ;
  Button[2]:=Add_DItem(Box,G_Button,Selectable|Exit_Btn,15,6,10,1,0,0);
  Set_DText(Box, Button[2], Button_String[2], System_Font, TE_Center ) ;
  Center_Dialog(Box);
  X :=Do_Dialog(Box,Item);
  Get_DEdit(Box,Item,input);
  upcase_string(input);
  Cancel := (X = Button[2]);
  if (not cancel) and (length(input) = 0) then cancel := true;
  End_Dialog(Box);
  Delete_Dialog(Box);
End;

Procedure Non_Exist_Prompt;
var x : integer;
begin
  X := Do_alert('[3][ | Nothing in memory!     ][ Continue ]',1);
end;


Procedure Do_Menu( title, item : integer ) ;
Var
  Alert : Str255 ;

Begin
  If Title = 3 then About_Program;
  Menu_Normal( Menu, Title ) ;
  Choice := Item - 15;
End;

Procedure Event_Loop ;
Var
  Which : Integer ;
  Msg : Message_Buffer ;
  dummy : integer;

Begin
  which := Get_Event( E_Message, 0, 0, 0, 0,
           false, 0, 0, 0, 0, false, 0, 0, 0, 0, msg,
           dummy, dummy, dummy, dummy, dummy, dummy ) ;
  Case Msg[0] of
     MN_Selected :  Do_Menu( msg[3], msg[4] ) ;
  End;
End;


Procedure set_dta( Var buf : frec );
Gemdos($1a);


Function get_first(Var path : path_type;
                       search_attrib :integer ) : integer ;
Gemdos($4e) ;


Function get_next : integer;
Gemdos($4f) ;

Procedure Do_Folder(Path_String : Str255);
Var
    dummy_string : Str255;
    r : frec;
    i : integer;
    p : integer;


    Procedure add_file(r : frec);
    Var
      i : integer;
      end_string : boolean;
    Begin
      end_string := false;
      Catalog[Rec_Count].fname := '';
      i := 1 ;
      while (i <= 12) and (not end_string) do
      Begin
        if (r.name[i] = chr(0)) then end_string := true
         else
          Catalog[Rec_Count].fname := concat(Catalog[rec_count].fname,
             r.name[i]);
        i := i + 1;
      End;
      Catalog[Rec_Count].folder_num := folder_max;
      Catalog[Rec_Count].desc := '';
      rec_count := rec_count + 1;
    End;


Begin
  For i := 1 to length(path_string) do path[i] := path_string[i];
  path[length(path_string)+1] := chr(0);
  set_dta(r);
  If get_first( path, $10 ) > -1 then
  Repeat
    if (r.attrib = $10) and (r.name[1] <> '.') then
    begin
      dummy_string := path_string;
      i := 1;
      While (i <= 14) AND (r.name[i] <> chr(0)) do
      Begin
        p:= pos('*.*',dummy_string);
        insert(r.name[i],dummy_string,p);
        i := i + 1
      End;
      p:= pos('*.*',dummy_string);
      insert('\',dummy_string,p);
      folder_array[folder_count] := dummy_string;
      folder_count := folder_count + 1;
    end else if r.name[1] <> '.' then add_file(r);
  until get_next < 0 ;
End;


Procedure Log_Disk;
var Log_drive : Str255;
    cancel : boolean;

begin
  Get_Entry(' Log which drive? ',Log_drive,1,cancel);
  if (not cancel) and (Log_drive[1] in ['A'..'P']) then
  begin
    Set_Mouse(M_Bee);
    Log_drive := Concat(Log_Drive,':\*.*');
    folder_count := 1;
    rec_count := 1;
    folder_max := 1;
    folder_array[1] := Log_drive;
    folder_count := folder_count + 1;
    do_folder(Log_drive);
    if folder_count-1 > 1 then
    begin
      folder_max := folder_max + 1;
      repeat
        do_folder(folder_array[folder_max]);
        folder_max := folder_max + 1;
      until  folder_max = folder_count;
    end;
    Set_Mouse(M_Arrow);
    If Rec_Count <= 1 then Non_Exist_Prompt;
  end;
end;


Procedure Load_file;
var log_drive,fil,pat : Str255;
    x : integer;
    cancel : boolean;
    outfile : text;
Begin
  Get_Entry(' Data files are on which drive? ',Log_drive,1,cancel);
  if not (Log_drive[1] in ['A'..'P']) then cancel:= true;
  if not cancel then
  begin
    pat:=concat(log_drive,':\CATALOG.INF\*.*');
    fil:='';
    if get_in_file(pat,fil) then
    begin
      set_mouse(M_bee);
      IO_check(false);
      Reset(outfile,fil);
      if IO_result = 0 then
      begin
        readln(outfile,Disk_name);
        readln(outfile,folder_count);
        for x := 1 to folder_count do readln(outfile,folder_array[x]);
        readln(outfile,rec_count);
        for x := 1 to rec_count -1 do
        begin
          readln(outfile,catalog[x].folder_num);
          readln(outfile,catalog[x].fname);
          readln(outfile,catalog[x].desc);
        end;
        close(outfile);
        disk_name :=concat(fil,', ',disk_name);
        x := pos('\CATALOG.INF',disk_name);
        delete(disk_name,x,12);
      end
      else X := Do_alert('[2][ | Disk problem...        ][ Abort ]',1);
      set_mouse(M_Arrow);
      IO_Check(True);
    end;
  end;
End;


Procedure Save_file;
var cancel : boolean;
    name,fil,pat,prompt,log_drive : Str255;
    x : integer;
    outfile : text;
Begin
  prompt :=' Description of disk contents: ';
  Get_Entry(prompt,name,30,cancel);
  if not cancel then
  begin
    disk_name := name;
    Get_Entry(' Data files are on which drive? ',Log_drive,1,cancel);
    if not (Log_drive[1] in ['A'..'P']) then cancel:= true;
  end;
  if (not cancel) then
  begin
    pat:=concat(Log_drive,':\CATALOG.INF\*.*');
    fil:='';
    if (get_in_file(pat,fil)) and (Get_Out_file('Are you sure?',fil)) then
    begin
      IO_Check(false);
      Rewrite(outfile,fil);
      if IO_Result = 0 then
      begin
        set_mouse(M_bee);
        writeln(outfile,name);
        writeln(outfile,folder_count);
        for x := 1 to folder_count do writeln(outfile,folder_array[x]);
        writeln(outfile,rec_count);
        for x := 1 to rec_count -1 do
        begin
          writeln(outfile,catalog[x].folder_num);
          writeln(outfile,catalog[x].fname);
          writeln(outfile,catalog[x].desc);
        end;
        close(outfile);
        disk_name :=concat(fil,', ',disk_name);
        x := pos('\CATALOG.INF',disk_name);
        delete(disk_name,x,12);
        set_mouse(M_arrow);
      end else X := Do_alert('[3][ | Disk problem...     ][ Abort ]',1);
      IO_Check(true);
    End;
  End;
End;


Procedure Print_file;
Var I,
    prev_folder : integer;
    F : Text;
Begin
  I := Do_alert('[2][ | Hardcopy...            ][ Yes | No ]',1);
  If i = 1 then
  begin
    Set_Mouse(M_Bee);
    rewrite(F,'LST:');
    prev_folder := 0;
    writeln(f,disk_name);
    writeln(f);
    for i := 1 to rec_count -1 do
    begin
       if prev_folder <> Catalog[i].folder_num then
       writeln(F,Folder_array[Catalog[i].folder_num]);
       writeln(F,'   ',Catalog[i].fname,'   ',Catalog[i].desc);
       prev_folder := Catalog[i].folder_num;
    end;
    Set_Mouse(M_arrow);
  end;
End;

Procedure Locate_file;
var i, x : integer;
    Log_drive,fspec,prompt,search_string,inline : str255;
    cancel,found,error : boolean;
    infile : text;
Begin
   Get_Entry(' Data files are on which drive? ',Log_drive,1,cancel);
   if (not cancel) and (Log_drive[1] in ['A'..'P']) then
   begin
     folder_count := 1;
     rec_count := 1;
     Log_drive := Concat(Log_Drive,':\CATALOG.INF\*.*');
     folder_array[1] := Log_drive;
     folder_count := folder_count + 1;
     do_folder(Log_drive);
     folder_max := folder_max + 1;
     found := false;
     X := 1;
     prompt := 'Search for filespec/Description: ';
     Get_Entry(prompt,search_string,30,cancel);
     if not cancel then
     begin
       IO_Check(False);
       set_mouse(M_Bee);
       error := false;
       while (X < rec_count) and (not found) and (not error) do
       begin
         fspec := concat(Folder_array[1],catalog[x].fname);
         i := pos('*.*',fspec);
         delete(fspec,i,3);
         reset(infile,fspec);
         if IO_Result <> 0 then error := true else
         while not eof(infile) do
         begin
           readln(infile,inline);
           while (inline[length(inline)] = ' ') do
           begin
             i := length(inline);
             delete(inline,i,1);
           end;
           if pos(search_string,inline) > 0 then found := true;
         end;
         X := X + 1;
       end;
       set_mouse(M_arrow);
       IO_Check(True);
       if error then x := do_alert('[2][ | Disk problem...   ][ Abort ]',1)
       else if found then
       begin
         prompt := concat('[1][ | Found ', search_string,
            '| in ',fspec,'][Done]');
         X := Do_alert(prompt,1);
       end
       else
       begin
         prompt := concat('[1][ | Could not find:| ',search_string,'][Done]');
         X := Do_alert(prompt,1);
       end;
       rec_count := 0;
     End;
   end;
End;



Procedure Edit_Routine(start : integer; var button_choice: integer);
Var
    Left,
    Top,
    Height,
    X,
    Dummy  : Integer;
    Dummy_String : Str255;
    ct : integer;
    Item_String,Edit_String,Default: Array[1..17] of Str255;
    Edit,Item : Array [1..17] of Integer;
    Button : Array [1..8] of Integer;
    Button_String : Array[1..8] of Str255;
    Box : Dialog_Ptr;
    End_Folder : Boolean;
    Current_Folder : integer;
    Start_dialog, Edit_max : integer;
Begin
  Box := New_Dialog(60,0,0,78,23);
  Start_Dialog := 0;
  edit_max := 0;
  ct := 1;
  Current_folder :=  Catalog[ct+start-1].folder_num;
  end_folder := false;
  while (CT < 15) and (CT < rec_count) and (not end_folder) do
  begin
    if current_folder = Catalog[CT+Start-1].folder_num then
    begin
      if start_dialog = 0 then start_dialog := Edit[CT];
      Item_String[CT]:=Concat('  ',Catalog[CT+start-1].fname);
      Default[CT] := Catalog[ct+start-1].desc;
      Item[ct] := Add_DItem(Box,G_String,None,1,ct+1,0,1,0,0);
      Set_DText(Box,Item[ct],Item_String[ct],System_Font,Te_Left);
      Dummy_String := '________________________________________';
      Edit[CT]:= Add_DItem(Box,G_FText,None,35,CT+1,50,1,0,$1180);
      Set_DEdit(Box,Edit[CT],Dummy_String,
                'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',
                Default[CT], System_Font,Te_Left);
      CT := CT + 1;
      edit_max := edit_max + 1;
    end else end_folder := true;
  end;
  Button_String[1] := '<<';
  Button_String[2] := '>>';
  Button_String[3] := 'Exit';
  Button_String[4] := 'Prev Dir';
  Button_String[5] := 'Next Dir';
  Button_String[6] := 'Search';
  Button_String[7] := 'Add';
  Button_String[8] := 'Delete';
  x:=Add_DItem(Box,G_String,None,1,1,0,1,0,0);
  Dummy_String := Concat('Description of files in directory: ',
                 Folder_array[Catalog[start].folder_num]);
  Set_DText(Box,x,Dummy_String,System_Font,Te_Left);
  Dummy_String := Concat('  Contents: ',disk_name);
  x:=Add_DItem(Box,G_String,None,1,17,0,1,0,0);
  Set_DText(Box,x,Dummy_String,System_Font,Te_left);

  For X := 1 to 3 do
  Begin
    Button[x]:=Add_DItem(Box,G_Button,
     Selectable|Touch_Exit,((x-1)*12)+3,19,10,1,0,0);
    Set_DText(Box, Button[x], Button_String[x], System_Font, TE_Center ) ;
  End;
  For X := 4 to 8 do
  Begin
    Button[x]:=Add_DItem(Box,G_Button,
     Selectable|Touch_Exit,((x-4)*12)+3,21,10,1,0,0);
    Set_DText(Box, Button[x], Button_String[x], System_Font, TE_Center ) ;
  End;

 Center_Dialog(Box);
  X :=Do_Dialog(Box,Start_dialog);
  for ct := 1 to 8 do if x = button[ct] then button_choice := ct;
  if edit_max <> 0 then
  for ct := 1 to Edit_Max do
  begin
    Get_DEdit(Box,Edit[CT],dummy_string);
    upcase_string(dummy_string);
    Catalog[Start+CT-1].desc := copy(dummy_string,1,length(Dummy_String));
  end;
  End_Dialog(Box);
  Delete_Dialog(Box);
End;

Procedure Edit_File;
var ct, edit_start,prev_folder,button : integer;
    dummy_string : str255;
    search_result : boolean;


    Procedure Next_Dir;
    begin
      ct := edit_start;
      prev_folder := catalog[ct].folder_num;
      while (Prev_folder = catalog[ct].folder_num) and (ct<rec_count-1) do
        ct := ct + 1;
      if (prev_folder <> catalog[ct].folder_num) then edit_start := ct;
    end;

    Procedure Prev_Dir;
    var folder_found : boolean;
    begin
      ct := edit_start;
      prev_folder := catalog[ct].folder_num;
      folder_found := false;
      while (not folder_found) and (CT > 1) do
       if (prev_folder <> catalog[ct].folder_num) then folder_found:=true else
          ct := ct - 1;
      if folder_found then
      begin
        prev_folder := catalog[ct].folder_num;
        folder_found := false;
        while (not folder_found) and (CT > 1) do
        if (prev_folder<> catalog[ct].folder_num) then folder_found:=true else
           ct := ct - 1;
        edit_start := ct+1;
      end;
    end;


    Procedure Down_Page;
    var s : integer;
    begin
      s := edit_start;
      edit_start:=edit_start +14;
      if edit_start > rec_count-1 then edit_start := s;
      if catalog[s].folder_num <> catalog[edit_start].folder_num then
        begin
          edit_start := s;
          next_dir;
        end;
    end;

    Procedure Up_Page;
    var s : integer;
    begin
      s := edit_start;
      edit_start:=edit_Start-14;
      if edit_start < 1 then edit_start := 1;
      if catalog[s].folder_num <> catalog[edit_start].folder_num then
        begin
          edit_start := s;
          prev_dir;
        end;
    end;

    Procedure search_spec(prompt : str255; var found : boolean);
    var cancel : boolean;
        search_string : Str255;
    begin
      found := false;
      Get_Entry(prompt,search_string,12,cancel);
      if not cancel then
      begin
        search_string :=concat(search_string,'                    ');
        CT := Edit_start;
        while (CT < rec_count ) and (not found) do
          if pos(catalog[ct].fname,search_string) > 0 then found := true
              else ct := ct + 1;
        if found then edit_start := ct
           else Ct := Do_alert('[1][ | Spec not found.     ][ Continue ]',1);
      end;
    end;

    Procedure add_spec;
    var fil,pat : str255;
        i : integer;
        exit_loop, newfolder : boolean;
    Begin
       fil := '';
       pat := folder_array[catalog[edit_start].folder_num];
       if get_in_file(pat,fil) then
       begin
         pat[1]:=folder_array[catalog[edit_start].folder_num,1];
         i := length(fil);
         exit_loop := false;
         while (I >0) and (not exit_loop) do
          if (fil[I]='\') or (fil[i]=':') then exit_loop := true
           else i := i - 1;
         if i <> 0 then delete(fil,1,i);
         fil := concat(fil,'            ');
         newfolder := true;
         for i := 1 to folder_count-1 do
           if pat = folder_array[i] then newfolder := false;
         if newfolder then
         begin
           folder_array[folder_count] := pat;
           catalog[rec_count].folder_num := folder_count;
           catalog[rec_count].fname := copy(fil,1,12);
           catalog[rec_count].desc := '';
           edit_start := rec_count;
           rec_count := rec_count + 1;
           folder_count := folder_count + 1;
         end
         else
         begin
           exit_loop := false;
           i := 1;
           while (I < rec_count) and (not exit_loop) do
            if folder_array[catalog[i].folder_num] = pat then exit_loop:=true
                else I := I + 1;
           edit_start := i;
          for i:= rec_count downto edit_start+1 do catalog[i] := catalog[i-1];
           catalog[i].fname := copy(fil,1,12);
           catalog[i].desc := '';
           rec_count := rec_count + 1;
         end;
       end;
   end;

   Procedure delete_spec;
   var dummy_string : str255;
       found : boolean;
       i : integer;

   begin
     dummy_string := ' Delete filespec : ';
     search_spec(dummy_string,found);
     if found then
     begin
       for i := edit_start to rec_count-1 do catalog[i]:= catalog[i+1];
       rec_count := rec_count-1;
       if edit_start > rec_count-1 then edit_start := rec_count-1;
     end;
   end;


Begin
  Edit_start := 1;
  dummy_string := ' Search for filespec: ';
  repeat
    Edit_routine(edit_start,button);
    Case button of
            1 : up_page;
            2 : down_page;
            4 : if (edit_start > 1) then prev_dir;
            5 : next_dir;
            6 : search_spec(dummy_string,search_result);
            7 : add_spec;
            8 : delete_spec;
         end;
  until button = 3;
end;

Begin { Main Program }
  Gem_Initialize;
  About_Program;
  Disk_name :='Unknown';
  Rec_count := 0;
  While 1=1 Do
  Begin
    Draw_Menu (Menu);
    Event_loop;
    Erase_menu( menu );
    if Choice = 7 then
    if do_alert('[2][ | Exit Program...       |][ Yes | No ]',1) = 1 then
    Begin
      Erase_menu(menu);
      Exit_Gem;
      Halt;
    End;
    If Choice = 1 then Log_disk;
    If Choice = 2 then Load_file;
    If Choice = 3 then Locate_file;
    If (Choice in [4..6]) and (Rec_count <= 1) then Non_Exist_prompt
    else
    begin
      If Choice = 4 then Save_file;
      If Choice = 5 then Edit_file;
      If Choice = 6 then Print_file;
    end;
    Choice := 0;
  End;
End.